;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "iDecorate.lisp")
(require "iimage.lisp")

(module mDecorate
  (include-book "avl-rational-keys" :dir :teachpacks)
  (import IImage)
  
  (defun shift (tr delta)
    (if (consp tr)
            (tree (+ (key tr) delta)
                  (data tr)
                  (shift (left tr) delta)
                  (shift (right tr) delta))
        ()))
  
 (defun shift-inner (tr delta)
   (if (consp tr)
       (tree (key tr) (shift (data tr) delta) (shift-inner (left tr) delta) (shift-inner (right tr) delta))
       ()))
  
  (defun pillar-box-helper (tr delta px w)
    (if (> delta 0)
        (pillar-box-helper (avl-insert (avl-insert tr delta px) (1+ (- w delta)) px) (1- delta) px w)
        tr))
  
  (defun pillar-box (tr delta px w)
    (if (consp tr)
        (tree (key tr) (pillar-box-helper (data tr) delta px w) (pillar-box (left tr) delta px w) (pillar-box (right tr) delta px w))
        ()))
  
  (defun row (tr px w)
    (if (>= w 0)
        (row (avl-insert tr (1+ w) px) px (1- w))
        tr))
  
  (defun letter-box (tr delta px w)
    (if (> delta 0)
        (letter-box (avl-insert (avl-insert tr delta (row () px w)) (1+ (- w delta)) (row () px w)) (1- delta) px w)
        tr))
  
  (defun border (tr delta r g b)
    (let* ((px (createRGB r g b))
           (hdr (cdr (avl-retrieve tr -1)))
           (w  (+ (* 2 delta) (getWidth tr)))
           (h  (+ (* 2 delta) (getHeight tr))))
      (if (consp tr)
          (avl-insert (avl-insert (avl-insert (letter-box (shift (pillar-box (shift-inner (avl-delete (avl-delete (avl-delete tr -1) -2) -3) delta) delta px w) delta) delta px h) -1 hdr) -2 w) -3 h)
          ())))
  
    (defun MainDecorate (tree args)
      (let* ((w (car args))
             (r (cadr args))
             (g (caddr args))
             (b (cadddr args)))
      (if (or (<= w 0) (or (< r 0) (> r 255)) (or (< g 0) (> g 255)) (or (< b 0) (> b 255)))
          (mv tree (list "Improper syntax - Usage: Decorate <width> <red> <green> <blue>"))
          (mv (border tree w r g b) (list "Successfully decorated image.")))))
  
  (export iDecorate))